Attribute VB_Name = "LAYCtrl"
'===============================================================================
' Layout Control
' ExeName.lay file
' Version 1
' 05 Dec 03
'
'   Public Sub aReset()
'   Public Sub aLoad(LayOutFileName As String)
'   Public Sub aSave()
'   Public Sub aShow()
'       Private Sub LaySetInitalValues()
'       Private Sub LoadLayFile(LayOutFileName As String)
'       Private Sub SaveLayFile()
'       Private Function GetTitle() As String
'       Private Function CheckIfFileExists(FilePathNameExt As String) As Boolean
'       Private Sub ShowLayData()
'
'===============================================================================

Option Explicit
DefLng A-Z

'Project wide layout constants
Public Const DRAWNORM = 13 'Copy Pen
Public Const DRAWXOR = 7 'XOR Pen
Public Const DEFSNAPX = 8
Public Const DEFSNAPY = 8
Public Const DEFDESCXOS = 8
Public Const DEFDESCYOS = 10
Public Const SCLPIXEL = 3
Public Const WINNORM = 0
Public Const WINMIN = 1
Public Const WINMAX = 2
Public Const OBJResetHeight = 18
Public Const OBJResetWidth = 40
Public Const OBJResetLeft = 0
Public Const OBJResetTop = 0
Public Const MMIResetWidth = 4500
Public Const MMIResetHeight = 2000
Public Const MMIBackColor = &HFFFFFF

'Define a global layout data type
Private Type GlobalValues
    Title As String
    LayFileName As String
    ObjFileName As String
    Left As Integer
    Top As Integer
    Width As Integer
    Height As Integer
    WinState As Integer
    SETLeft As Integer
    SETTop As Integer
    AutoLoad As Integer
    AutoSave As Integer
    AutoStart As Integer
    SnapX As Integer
    SnapY As Integer
    DescXos As Integer
    DescYos As Integer
    Snap As Integer
    BackColor As Long
End Type

'Dim LAY - a global database of layout information using the above defined data type
Public LAY As GlobalValues

Public Sub aReset()
    LaySetInitalValues
End Sub

Public Sub aLoad(LayOutFileName As String)
    LoadLayFile LayOutFileName
End Sub

Public Sub aSave()
    SaveLayFile
End Sub

Public Sub aShow()
    ShowLayData
End Sub

'=========================== Private =================================

'Initalize the layout data
Private Sub LaySetInitalValues()
    With LAY
        .Title = App.EXEName
        .LayFileName = App.Path & "\" & App.EXEName & ".lay"
        .ObjFileName = App.Path & "\" & App.EXEName & ".obj"
        .Left = Screen.Width * 0.1
        .Top = Screen.Height * 0.1
        .Width = MMIResetWidth
        .Height = MMIResetHeight
        .WinState = 0
        .SETLeft = Screen.Width * 0.2
        .SETTop = Screen.Height * 0.2
        .AutoLoad = 0
        .AutoSave = 0
        .AutoStart = 0
        .SnapX = DEFSNAPX
        .SnapY = DEFSNAPY
        .DescXos = 2
        .DescYos = 3
        .Snap = 1
        .BackColor = MMIBackColor
    End With
End Sub

'Load Layout file
Private Sub LoadLayFile(LayOutFileName As String)
    If Not UCase(Right(LayOutFileName, 3)) = "LAY" Then MsgBox "Layout file " & LayOutFileName & " has a invalid extension, only .lay is acceptable - select another file with a .lay extension.": Exit Sub
    If Not CheckIfFileExists(LayOutFileName) Then MsgBox "Layout file " & LayOutFileName & " not found. Just continue and save - that will create a layout file to load.": Exit Sub
    Dim fPt: fPt = FreeFile
    Dim Rec As String
    Dim Key As String
    Dim Val As String
    Dim Split
    Open LayOutFileName For Input As fPt
        While Not EOF(fPt)
            Line Input #fPt, Rec
            Split = InStr(Rec, "=")
            If Split > 0 Then
                Key = Trim(Left(Rec, Split - 1))
                Val = Trim(Mid(Rec, Split + 1))
                With LAY: Select Case Key
                    Case "Left":     .Left = Val
                    Case "Top":     .Top = Val
                    Case "Width":     .Width = Val
                    Case "Height":     .Height = Val
                    Case "WinState":     .WinState = Val
                    Case "SETLeft":     .SETLeft = Val
                    Case "SETTop":     .SETTop = Val
                    Case "AutoLoad":     .AutoLoad = Val
                    Case "AutoSave":     .AutoSave = Val
                    Case "AutoStart":     .AutoStart = Val
                    Case "SnapX":     .SnapX = Val
                    Case "SnapY":     .SnapY = Val
                    Case "DescXos":     .DescXos = Val
                    Case "DescYos":     .DescYos = Val
                    Case "Snap":     .Snap = Val
                    Case "BackColor":     .BackColor = Val
                End Select: End With
            End If
        Wend
    Close fPt
    LAY.LayFileName = LayOutFileName
    LAY.ObjFileName = Left(LAY.LayFileName, Len(LAY.LayFileName) - 4) & ".obj"
    LAY.Title = GetTitle
End Sub

'Save LAYout to file
Private Sub SaveLayFile()
    LAY.Title = GetTitle
    MMI.Caption = LAY.Title
    Dim fPt:    fPt = FreeFile
    Open LAY.LayFileName For Output As fPt
        Print #fPt, "Left=" & MMI.Left
        Print #fPt, "Top=" & MMI.Top
        Print #fPt, "Width=" & MMI.Width
        Print #fPt, "Height=" & MMI.Height
        Print #fPt, "WinState=" & MMI.WindowState
        Print #fPt, "SETLeft=" & LAY.SETLeft
        Print #fPt, "SETTop=" & LAY.SETTop
        Print #fPt, "AutoLoad=" & LAY.AutoLoad
        Print #fPt, "AutoSave=" & LAY.AutoSave
        Print #fPt, "AutoStart=" & LAY.AutoStart
        Print #fPt, "SnapX=" & LAY.SnapX
        Print #fPt, "SnapY=" & LAY.SnapY
        Print #fPt, "DescXos=" & LAY.DescXos
        Print #fPt, "DescYos=" & LAY.DescYos
        Print #fPt, "Snap=" & LAY.Snap
        Print #fPt, "BackColor=" & MMI.BackColor
    Close fPt
End Sub

Private Function GetTitle() As String
    Dim sSrch As String
    Dim pT As Integer
    sSrch = LAY.LayFileName
    For pT = Len(sSrch) To 1 Step -1
        If Mid(sSrch, pT, 1) = "/" Then Exit For
        If Mid(sSrch, pT, 1) = "\" Then Exit For
    Next
     GetTitle = Mid(sSrch, pT + 1, Len(sSrch) - pT - 4)
End Function

'Check if a file exists
Private Function CheckIfFileExists(FilePathNameExt As String) As Boolean
    On Error GoTo fileerr
    If FileLen(FilePathNameExt) > 0 Then
        CheckIfFileExists = True
    Else
        CheckIfFileExists = False
    End If
    Exit Function
fileerr:
    CheckIfFileExists = False
End Function

'Show the global values
Private Sub ShowLayData()
    Dim S As String
    S = S & "Title = " & LAY.Title & vbNewLine
    S = S & "LayFileName = " & LAY.LayFileName & vbNewLine
    S = S & "ObjFileName = " & LAY.ObjFileName & vbNewLine
    S = S & "Left = " & LAY.Left & vbNewLine
    S = S & "Top = " & LAY.Top & vbNewLine
    S = S & "Width = " & LAY.Width & vbNewLine
    S = S & "Height = " & LAY.Height & vbNewLine
    S = S & "WinState = " & LAY.WinState & vbNewLine
    S = S & "SETLeft = " & LAY.SETLeft & vbNewLine
    S = S & "SETTop = " & LAY.SETTop & vbNewLine
    S = S & "AutoLoad = " & LAY.AutoLoad & vbNewLine
    S = S & "AutoSave = " & LAY.AutoSave & vbNewLine
    S = S & "AutoStart = " & LAY.AutoStart & vbNewLine
    S = S & "SnapX = " & LAY.SnapX & vbNewLine
    S = S & "SnapY = " & LAY.SnapY & vbNewLine
    S = S & "DescXos = " & LAY.DescXos & vbNewLine
    S = S & "DescYos = " & LAY.DescYos & vbNewLine
    S = S & "Snap = " & LAY.Snap & vbNewLine
    MsgBox S
End Sub
